Developer CD Series 1995…tember: Reference Library/Dev.CD Sep 95 RL/Dev.CD Sep 95 RL.toast/mac/Technical Documentation/develop/develop Issue 1 code/the Palette Manager/Sample.f/Sample.p

Text File | 1989-09-20 | 17.3 KB | 654 lines | [TEXT/MPS ]

{------------------------------------------------------------------------------
#
#    Apple Macintosh Developer Technical Support
#
#    MultiFinder-Aware Simple Sample Application
#
#    Sample
#
#    Sample.p    -    Pascal Source
#
#    Copyright © 1989 Apple Computer, Inc.
#    All rights reserved.
#
#    Versions:
#                1.00                08/88
#                1.01                11/88
#                1.02                04/89    MPW 3.1
#
#    Components:
#                Sample.p            April 1, 1989
#                Sample.c            April 1, 1989
#                Sample.a            April 1, 1989
#                Sample.inc1.a        April 1, 1989
#                SampleMisc.a        April 1, 1989
#                Sample.r            April 1, 1989
#                Sample.h            April 1, 1989
#                [P]Sample.make        April 1, 1989
#                [C]Sample.make        April 1, 1989
#                [A]Sample.make        April 1, 1989
#
#    Sample is an example application that demonstrates how to
#    initialize the commonly used toolbox managers, operate
#    successfully under MultiFinder, handle desk accessories,
#    and create, grow, and zoom windows.
#
#    It does not by any means demonstrate all the techniques
#    you need for a large application. In particular, Sample
#    does not cover exception handling, multiple windows/documents,
#    sophisticated memory management, printing, or undo. All of
#    these are vital parts of a normal full-sized application.
#
#    This application is an example of the form of a Macintosh
#    application; it is NOT a template. It is NOT intended to be
#    used as a foundation for the next world-class, best-selling,
#    600K application. A stick figure drawing of the human body may
#    be a good example of the form for a painting, but that does not
#    mean it should be used as the basis for the next Mona Lisa.
#
#    We recommend that you review this program or TESample before
#    beginning a new application.
#
------------------------------------------------------------------------------}


PROGRAM Sample;


{Segmentation strategy:

 This program consists of three segments. Main contains most of the code,
 including the MPW libraries, and the main program. Initialize contains
 code that is only used once, during startup, and can be unloaded after the
 program starts. %A5Init is automatically created by the Linker to initialize
 globals for the MPW libraries and is unloaded right away.}


{SetPort strategy:

 Toolbox routines do not change the current port. In spite of this, we use
 a strategy of calling SetPort whenever we want to draw or make calls which depend
 on the current port. This makes us less vulnerable to bugs in other software which
 might alter the current port (such as the bug (feature?) in many desk accessories
 which change the port on OpenDeskAcc).  Hopefully, this also makes the routines
 from this program more self-contained, since they don't depend on the current
 port setting.}


USES
    MemTypes, QuickDraw, OSIntf, ToolIntf, PackIntf, Traps;

CONST

    kSysEnvironsVersion        = 1;

    kOSEvent                = app4Evt;    {event used by MultiFinder}
    kSuspendResumeMessage    = 1;        {high byte of suspend/resume event message}
    kResumeMask                = 1;        {bit of message field for resume vs. suspend}
    kNoEvents                = 0;        {no events mask}

    kMinHeap    = 21 * 1024;

    kMinSpace    = 8 * 1024;

    {kExtremeNeg and kExtremePos are used to set up wide open rectangles and regions.}
    kExtremeNeg    = -32768;
    kExtremePos    = 32767 - 1;            {required for old region bug}

    {These constants are all resource IDs, corresponding to resources in Sample.r.}
    rMenuBar    = 128;                    {application's menu bar}
    rAboutAlert    = 128;                    {about alert}
    rUserAlert    = 129;                    {error user alert}
    rWindow        = 128;                    {application's window}
    rStopRect    = 128;                    {rectangle for Stop light}
    rGoRect        = 129;                    {rectangle for Go light}

    {These constants are used to identify menus and their items. The menu IDs
     have an "m" prefix and the item numbers within each menu have an "i" prefix.}
    mApple        = 128;                    {Apple menu}
    iAbout        = 1;

    mFile        = 129;                    {File menu}
    iNew        = 1;
    iClose        = 4;
    iQuit        = 12;

    mEdit        = 130;                    {Edit menu}
    iUndo        = 1;
    iCut        = 3;
    iCopy        = 4;
    iPaste        = 5;
    iClear        = 6;

    mLight        = 131;                    {Light menu}
    iStop        = 1;
    iGo            = 2;

    {1.01 - kDITop and kDILeft are used to locate the Disk Initialization dialogs.}
    kDITop        = $0050;
    kDILeft        = $0070;


VAR
    {The "g" prefix is used to emphasize that a variable is global.}

    gMac                : SysEnvRec;    {set up by Initialize}
    gHasWaitNextEvent    : BOOLEAN;        {set up by Initialize}
    gInBackground        : BOOLEAN;        {maintained by Initialize and DoEvent}
    gStopped            : BOOLEAN;        {maintained by Initialize and SetLight}
    gStopRect            : Rect;            {set up by Initialize}
    gGoRect                : Rect;            {set up by Initialize}


{$S Initialize}
FUNCTION TrapAvailable(tNumber: INTEGER; tType: TrapType): BOOLEAN;

BEGIN
    IF (tType = ToolTrap) &
        (gMac.machineType > envMachUnknown) &
        (gMac.machineType < envMacII) THEN BEGIN        {it's a 512KE, Plus, or SE}
        tNumber := BAND(tNumber, $03FF);
        IF tNumber > $01FF THEN                            {which means the tool traps}
            tNumber := _Unimplemented;                    {only go to $01FF}
    END;
    TrapAvailable := NGetTrapAddress(tNumber, tType) <>
                        GetTrapAddress(_Unimplemented);
END; {TrapAvailable}


{$S Main}
FUNCTION IsDAWindow(window: WindowPtr): BOOLEAN;

{Check if a window belongs to a desk accessory.}

BEGIN
    IF window = NIL THEN
        IsDAWindow := FALSE
    ELSE    {DA windows have negative windowKinds}
        IsDAWindow := WindowPeek(window)^.windowKind < 0;
END; {IsDAWindow}


{$S Main}
FUNCTION IsAppWindow(window: WindowPtr): BOOLEAN;

BEGIN
    IF window = NIL THEN
        IsAppWindow := FALSE
    ELSE    {application windows have windowKinds = userKind (8)}
        WITH WindowPeek(window)^ DO
            IsAppWindow := (windowKind = userKind);
END; {IsAppWindow}


{$S Main}
PROCEDURE AlertUser;

VAR
    itemHit    : INTEGER;
BEGIN
    SetCursor(arrow);
    itemHit := Alert(rUserAlert, NIL);
    ExitToShell;
END; {AlertUser}


{$S Main}
FUNCTION DoCloseWindow(window: WindowPtr) : BOOLEAN;

{Close a window.}

BEGIN
    DoCloseWindow := TRUE;
    IF IsDAWindow(window) THEN
        CloseDeskAcc(WindowPeek(window)^.windowKind);
    IF IsAppWindow(window) THEN
        CloseWindow(window);
END; {DoCloseWindow}


{$S Initialize}
FUNCTION GoGetRect(rectID: INTEGER; VAR theRect: Rect) : BOOLEAN;

TYPE
    RectPtr        = ^Rect;
    RectHnd        = ^RectPtr;
VAR
    resource    : Handle;
BEGIN
    resource := GetResource('RECT', rectID);
    IF resource <> NIL THEN BEGIN
        GoGetRect := TRUE;
        theRect := RectHnd(resource)^^;
        END
    ELSE
        GoGetRect := FALSE;
END; {GoGetRect}


{$S Initialize}
PROCEDURE Initialize;

VAR
    menuBar            : Handle;
    window            : WindowPtr;
    ignoreError        : OSErr;
    total, contig    : LongInt;
    ignoreResult    : BOOLEAN;
    event            : EventRecord;
    count            : INTEGER;

BEGIN
    gInBackground := FALSE;

    InitGraf(@thePort);
    InitFonts;
    InitWindows;
    InitMenus;
    TEInit;
    InitDialogs(NIL);
    InitCursor;

    FOR count := 1 TO 3 DO
        ignoreResult := EventAvail(everyEvent, event);

    ignoreError := SysEnvirons(kSysEnvironsVersion, gMac);

    {Make sure that the machine has at least 128K ROMs. If it doesn't, exit.}

    IF gMac.machineType < 0 THEN AlertUser;

    gHasWaitNextEvent := TrapAvailable(_WaitNextEvent, ToolTrap);

    IF ORD(GetApplLimit) - ORD(ApplicZone) < kMinHeap THEN AlertUser;

    PurgeSpace(total, contig);
    IF total < kMinSpace THEN AlertUser;

    window := WindowPtr(NewPtr(SIZEOF(WindowRecord)));
    IF window = NIL THEN AlertUser;
    window := GetNewWindow(rWindow, Ptr(window), WindowPtr(-1));

    menuBar := GetNewMBar(rMenuBar);        {read menus into menu bar}
    IF menuBar = NIL THEN AlertUser;
    SetMenuBar(menuBar);                    {install menus}
    DisposHandle(menuBar);
    AddResMenu(GetMHandle(mApple), 'DRVR');    {add DA names to Apple menu}
    DrawMenuBar;

    gStopped := TRUE;
    IF NOT GoGetRect(rStopRect, gStopRect) THEN
        AlertUser;                            {the stop light rectangle}
    IF NOT GoGetRect(rGoRect, gGoRect) THEN
        AlertUser;                            {the go light rectangle}
END; {Initialize}


{$S Main}
PROCEDURE Terminate;

{Clean up the application and exits. We close all of the windows so that
 they can update their documents, if any.}

{1.01 - If we find out that a cancel has occurred, we won't exit to the
 shell, but will return instead.}

VAR
    aWindow    : WindowPtr;
    closed    : BOOLEAN;

BEGIN
    closed := TRUE;
    REPEAT
        aWindow := FrontWindow;                    {get the current front window}
        IF aWindow <> NIL THEN
            closed := DoCloseWindow(aWindow);    {close this window}
    UNTIL (NOT closed) | (aWindow = NIL);        {do all windows}
    IF closed THEN
        ExitToShell;                            {exit if no cancellation}
END; {Terminate}


{$S Main}
PROCEDURE SetLight(window: WindowPtr; newStopped: BOOLEAN);

{Change the setting of the light.}

BEGIN
    IF newStopped <> gStopped THEN BEGIN
        gStopped := newStopped;
        SetPort(window);
        InvalRect(window^.portRect);
    END;
END; {SetLight}


{$S Main}
PROCEDURE AdjustMenus;

VAR
    window            : WindowPtr;
    menu            : MenuHandle;

BEGIN
    window := FrontWindow;

    menu := GetMHandle(mFile);
    IF IsDAWindow(window) THEN                {we can allow desk accessories to be closed from the menu}
        EnableItem(menu, iClose)
    ELSE
        DisableItem(menu, iClose);            {but not our traffic light window}

    menu := GetMHandle(mEdit);
    IF IsDAWindow(window) THEN BEGIN        {a desk accessory might need the edit menu}
        EnableItem(menu, iUndo);
        EnableItem(menu, iCut);
        EnableItem(menu, iCopy);
        EnableItem(menu, iPaste);
        EnableItem(menu, iClear);
    END ELSE BEGIN                            {but we know we do not}
        DisableItem(menu, iUndo);
        DisableItem(menu, iCut);
        DisableItem(menu, iCopy);
        DisableItem(menu, iClear);
        DisableItem(menu, iPaste);
    END;

    menu := GetMHandle(mLight);
    IF IsAppWindow(window) THEN BEGIN        {we know that it must be the traffic light}
        EnableItem(menu, iStop);
        EnableItem(menu, iGo);
    END ELSE BEGIN
        DisableItem(menu, iStop);
        DisableItem(menu, iGo);
    END;
    CheckItem(menu, iStop, gStopped);        {we can also determine check/uncheck state, too}
    CheckItem(menu, iGo, NOT gStopped);
END; {AdjustMenus}


{$S Main}
PROCEDURE DoMenuCommand(menuResult: LONGINT);

VAR
    menuID            : INTEGER;        {the resource ID of the selected menu}
    menuItem        : INTEGER;        {the item number of the selected menu}
    itemHit            : INTEGER;
    daName            : Str255;
    daRefNum        : INTEGER;
    handledByDA        : BOOLEAN;
    ignore            : BOOLEAN;

BEGIN
    menuID := HiWrd(menuResult);    {use built-ins (for efficiency)...}
    menuItem := LoWrd(menuResult);    {to get menu item number and menu number}
    CASE menuID OF
        mApple:
            CASE menuItem OF
                iAbout:                {bring up alert for About}
                    itemHit := Alert(rAboutAlert, NIL);
                OTHERWISE BEGIN        {all non-About items in this menu are DAs}
                    GetItem(GetMHandle(mApple), menuItem, daName);
                    daRefNum := OpenDeskAcc(daName);
                END;
            END;
        mFile:
            CASE menuItem OF
                iClose:
                    ignore := DoCloseWindow(FrontWindow); {we don't care if cancelled}
                iQuit:
                    Terminate;
            END;
        mEdit:                        {call SystemEdit for DA editing & MultiFinder}
            handledByDA := SystemEdit(menuItem-1);    {since we don't do any editing}
        mLight:
            CASE menuItem OF
                iStop:
                    SetLight(FrontWindow, TRUE);
                iGo:
                    SetLight(FrontWindow, FALSE);
            END;
    END;
    HiliteMenu(0);                    {unhighlight what MenuSelect (or MenuKey) hilited}
END; {DoMenuCommand}


{$S Main}
PROCEDURE DrawWindow(window: WindowPtr);

BEGIN
    SetPort(window);

    EraseRect(window^.portRect);    {clear out any garbage that might be left behind}
    IF gStopped THEN                {draw a red (or white) stop light}
        ForeColor(redColor)
    ELSE
        ForeColor(whiteColor);
    PaintOval(gStopRect);
    ForeColor(blackColor);
    FrameOval(gStopRect);
    IF NOT gStopped THEN            {draw a green (or white) go light}
        ForeColor(greenColor)
    ELSE
        ForeColor(whiteColor);
    PaintOval(gGoRect);
    ForeColor(blackColor);
    FrameOval(gGoRect);
END; {DrawWindow}


{$S Main}
PROCEDURE DoContentClick(window: WindowPtr; event: EventRecord);

BEGIN
    SetLight(window, NOT gStopped);
END; {DoContentClick}


{$S Main}
PROCEDURE DoUpdate(window: WindowPtr);

BEGIN
    IF IsAppWindow(window) THEN BEGIN
        BeginUpdate(window);                    {sets up the visRgn, clears updateRgn}
        IF NOT EmptyRgn(window^.visRgn) THEN    {draw if updating needs to be done}
            DrawWindow(window);
        EndUpdate(window);                        {restores the visRgn}
    END;
END; {DoUpdate}


{$S Main}
PROCEDURE DoActivate(window: WindowPtr; becomingActive: BOOLEAN);


BEGIN
    IF IsAppWindow(window) THEN
        IF becomingActive THEN
            {do whatever you need to at activation}
        ELSE
            {do whatever you need to at deactivation};
END; {DoActivate}


{$S Main}
PROCEDURE GetGlobalMouse(VAR mouse: Point);


VAR
    event    : EventRecord;

BEGIN
    IF OSEventAvail(kNoEvents, event) THEN;    {we aren't interested in any events}
    mouse := event.where;                    {just the mouse position}
END;


{$S Main}
PROCEDURE AdjustCursor(mouse: Point; region: RgnHandle);

VAR
    window                : WindowPtr;
    arrowRgn            : RgnHandle;
    plusRgn                : RgnHandle;
    globalPortRect        : Rect;


BEGIN
    window := FrontWindow;    {we only adjust the cursor when we are in front}
    IF (NOT gInBackground) AND (NOT IsDAWindow(window)) THEN BEGIN
        {calculate regions for different cursor shapes}
        arrowRgn := NewRgn;
        plusRgn := NewRgn;

        {start with a big, big rectangular region}
        {1.01 - changed to kExtremeNeg and kExtremePos for consistency}
        SetRectRgn(arrowRgn, kExtremeNeg, kExtremeNeg,
                            kExtremePos, kExtremePos);

        {calculate plusRgn}
        IF IsAppWindow(window) THEN BEGIN
            SetPort(window);            {make a global version of the portRect}
            SetOrigin(-window^.portBits.bounds.left, -window^.portBits.bounds.top);
            globalPortRect := window^.portRect;
            RectRgn(plusRgn, globalPortRect);
            SectRgn(plusRgn, window^.visRgn, plusRgn);
            SetOrigin(0, 0);
        END;

        {subtract other regions from arrowRgn}
        DiffRgn(arrowRgn, plusRgn, arrowRgn);

        {change the cursor and the region parameter}
        IF PtInRgn(mouse, plusRgn) THEN BEGIN
            SetCursor(GetCursor(plusCursor)^^);
            CopyRgn(plusRgn, region);
        END ELSE BEGIN
            SetCursor(arrow);
            CopyRgn(arrowRgn, region);
        END;

        {get rid of our local regions}
        DisposeRgn(arrowRgn);
        DisposeRgn(plusRgn);
    END;
END; {AdjustCursor}


{$S Main}
PROCEDURE DoEvent(event: EventRecord);

{Do the right thing for an event. Determine what kind of event it is, and call
 the appropriate routines.}

VAR
    part, err    : INTEGER;
    window        : WindowPtr;
    hit            : BOOLEAN;
    key            : CHAR;
    aPoint        : Point;

BEGIN
    CASE event.what OF
        mouseDown: BEGIN
            part := FindWindow(event.where, window);
            CASE part OF
                inMenuBar: BEGIN            {process the menu command}
                    AdjustMenus;
                    DoMenuCommand(MenuSelect(event.where));
                END;
                inSysWindow:                {let the system handle the mouseDown}
                    SystemClick(event, window);
                inContent:
                    IF window <> FrontWindow THEN BEGIN
                        SelectWindow(window);
                        {DoEvent(event);}    {use this line for "do first click"}
                    END ELSE
                        DoContentClick(window, event);
                inDrag:                        {pass screenBits.bounds to get all gDevices}
                    DragWindow(window, event.where, screenBits.bounds);
                inGrow:;
                inZoomIn, inZoomOut:;
            END;
        END;
        keyDown, autoKey: BEGIN                {check for menukey equivalents}
            key := CHR(BAnd(event.message, charCodeMask));
            IF BAnd(event.modifiers, cmdKey) <> 0 THEN    {Command key down}
                IF event.what = keyDown THEN BEGIN
                    AdjustMenus;            {enable/disable/check menu items properly}
                    DoMenuCommand(MenuKey(key));
                END;
        END;                                {call DoActivate with the window and...}
        activateEvt:                        {TRUE for activate, FALSE for deactivate}
            DoActivate(WindowPtr(event.message), BAnd(event.modifiers, activeFlag) <> 0);
        updateEvt:                          {call DoUpdate with the window to update}
            DoUpdate(WindowPtr(event.message));
        {1.01 - It is not a bad idea to at least call DIBadMount in response
         to a diskEvt, so that the user can format a floppy.}
        diskEvt:
            IF HiWrd(event.message) <> noErr THEN BEGIN
                SetPt(aPoint, kDILeft, kDITop);
                err := DIBadMount(aPoint, event.message);
            END;
        kOSEvent:
            CASE BAnd(BRotL(event.message, 8), $FF) OF    {high byte of message}
                kSuspendResumeMessage: BEGIN
                    gInBackground := BAnd(event.message, kResumeMask) = 0;
                    DoActivate(FrontWindow, NOT gInBackground);
                END;
            END;
    END;
END; {DoEvent}


{$S Main}
PROCEDURE EventLoop;

VAR
    cursorRgn    : RgnHandle;
    gotEvent    : BOOLEAN;
    event        : EventRecord;
    mouse        : Point;

BEGIN
    cursorRgn := NewRgn;                {we’ll pass WNE an empty region the 1st time thru}
    REPEAT
        IF gHasWaitNextEvent THEN BEGIN    {put us 'asleep' forever under MultiFinder}
            GetGlobalMouse(mouse);        {since we might go to sleep}
            AdjustCursor(mouse, cursorRgn);
            gotEvent := WaitNextEvent(everyEvent, event, MAXLONGINT, cursorRgn);
        END ELSE BEGIN
            SystemTask;                    {must be called if using GetNextEvent}
            gotEvent := GetNextEvent(everyEvent, event);
        END;
        IF gotEvent THEN BEGIN
            AdjustCursor(event.where, cursorRgn);    {make sure we have the right cursor}
            DoEvent(event);
        END;
        {If you are using modeless dialogs that have editText items,
         you will want to call IsDialogEvent to give the caret a chance
         to blink, even if WNE/GNE returned FALSE. However, check FrontWindow
         for a non-NIL value before calling IsDialogEvent.}
    UNTIL FALSE;                        {loop forever; we quit through an ExitToShell}
END; {EventLoop}


PROCEDURE _DataInit; EXTERNAL;

{$S Main}
BEGIN
    UnloadSeg(@_DataInit);    {note that _DataInit must not be in Main!}

    {1.01 - call to ForceEnvirons removed}
    {If you have stack requirements that differ from the default,
     then you could use SetApplLimit to increase StackSpace at
     this point, before calling MaxApplZone.}

    MaxApplZone;            {expand the heap so code segments load at the top}

    Initialize;                {initialize the program}
    UnloadSeg(@Initialize);    {note that Initialize must not be in Main!}

    EventLoop;                {call the main event loop}
END.